00100		TITLE	UDPLAY ;  WITH 'LOCK' OCT. 1970. MAY 1975
00200	
00300	;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
00400	;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
00500	;  
00600	;   READS FROM UDP DATA WRITTEN WITH 'CONVRT',  THE FIRST RECORD OF WHICH 
00700	;   CONTAINS THE NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
00800	;   IF 'BLKS' IS CHANGED, ALSO CHANGE IT IN 'CONVRT'.
00900	
01000	↓A   ←   1     ;WORK
01100	B   ←   2     ;WORK
01200	C   ←   4     ;WORK
01300	RET ←   3     ;RETURN ACCUMULATOR
01400	↓P   ←	17    ;A PDL
01500	PLEN←	10    ;SIZE OF PDL
01600	
01700	NOWAIT←400	; INHIBIT 'XXX is busy, will you wait?`
01800	
01900	EXTERNAL JOBFF,JOBREL,JOBSA,JOBSYM
02000	
02100	;** CHANGE NEXT TO 14 FOR 'UDPBIG' (TO PLAY AT HIGH SRATES-DOUBLES CORE)
02200	;SEE IF 20 RATHER THAN 7 KEEPS US GOIN'
02300	;BLKS ← =18
02400	BLKS ← =10
02500	
02600	;**** 1312 IS FOR 2314 DSK.  CHANGE NUMBER IF NEEDED FOR 3330 DSK. *****
02700	BUFSIZ ←=2336*BLKS
02800	
02900	↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
03000	↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT
03100	
03200		OPDEF	READCH	[51B8]
03300	        OPDEF   MESSAGE	[51B8!3B12]
03400		OPDEF 	LOCK	[CALLI 400076]
03500		OPDEF 	UNLOCK	[CALLI 400077]
03600	
03700	BEG:	HLRO A,JOBSYM	;SAVE SYMBOLS
03800		MOVN A,A
03900		ADD A,JOBSYM
04000		HRLM A,JOBSA
04100		HRRZM A,JOBFF
04200		CALLI 0         ;RESET I/O DEVICES
04300		MOVE P,[IOWD PLEN,PLIST]
04400		MESSAGE [ASCIZ/
04500	*** Play from the UDP (with Spacewar) ***
04600	/]
04700		PUSHJ P,GETUDP	;MAKE SURE WE HAVE UDP BEFORE DOING DIALOGUE
04800	
04900	;FIND OUT NUMBER OF CHANNELS AND
05000	;THE SPEED.
05100	NCHNS:	MESSAGE	[ASCIZ/
05200	How many channels? /]
05300		READCH	A
05400		CAIE A,175
05500		CAIN A,177
05600		JRST BEG
05700		CAIE A,15
05800		CAIN A,12
05900		JRST NCHNS+1
06000		SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
06100		CAIG A,3
06200		SKIPGE A
06300		JRST [	OUTSTR [ASCIZ/
06400	Illegal number of channels/]
06500			JRST NCHNS]
06600		DPB	A,[POINT 2,OUTBIT,26]
06700	
06800	SETSPD:	MESSAGE [ASCIZ/
06900	What is the speed? /]
07000		READCH  A
07100		CAIE A,175
07200		CAIN A,177
07300		JRST BEG
07400		CAIE A,15
07500		CAIN A,12
07600		JRST SETSPD+1
07700		SUBI	A,"0"
07800		CAIG A,5
07900		SKIPG A
08000		JRST [	OUTSTR [ASCIZ/
08100	Illegal speed/]
08200			JRST SETSPD]
08300		DPB	A,[POINT 3,OUTBIT,32]
08400	; GET READ TO PLAY
08500	
08600	LX:	MESSAGE [ASCIZ/
08700	Type 'P` to play:  /]
08800		readch a
08900		CAIE A,175
09000		CAIN A,177
09100		JRST BEG
09200		CAIE A,15
09300		CAIN A,12
09400		JRST LX+1
09500		caie a,"P"
09600		jrst LX
09700		PUSHJ P,[
09800		GETUDP:	INIT DSKCHN,NOWAIT+17  ;MODE
09900			SIXBIT/UDP/		;DEVICE NAME
10000			0			;NO BUFFER HEADERS
10100			SKIPA
10200			POPJ P,
10300			OUTSTR [ASCIZ/
10400	UDP is in use or assigned to another job.
10500	/]
10600			HALT BEG]	;RESTART IF DEVICE IS UNAVAILABLE
10700			
10800		ENTER	DSKCHN,[0
10900			0
11000			0
11100			0]
11200		JRST [	OUTSTR	[ASCIZ/
11300	I'm sorry, but I don't believe that you have the Scratch Pack mounted.
11400	Maybe someone has put a password on it.
11500	/]
11600			HALT BEG]	;FOR NEW UDP CODE
11700		MOVEI A,BUFSIZ+1	;GET FIRST BUFFER FOR UDP
11800		PUSHJ P,GETBUF
11900		SUBI A,1
12000		MOVEM A,PBUF1
12100		MOVEI A,BUFSIZ+1	;GET SECOND BUFFER FOR UDP
12200		PUSHJ P,GETBUF
12300		SUBI A,1
12400		MOVEM A,PBUF2
12500	GETAD:	OPEN	ADCHN,[117 	;MODE
12600	         	'AD    '        ;DEVICE NAME
12700	 		0]              ;NO BUFFER HEADERS
12800	
12900	  	JRST	[OUTSTR	[ASCIZ/
13000	D to A is unavailable.
13100	/]
13200			HALT GETAD]
13300		;HALT IF D-A IS UNAVAILABLE
13400	
13500	
13600		INPUT DSKCHN,[IOWD 22,NWD	;READ IN BLOCK CONTAINING EITHER
13700		               0 ]		;THE ADDRESS OF THE SCRATCH AREA
13800	 	MOVE NWD			;AND THE WORD COUNT, OR AN INDIC-
13900		CAME [SIXBIT/BITMAP/]		;ATION THAT THE SOUND STARTS IN
14000		JUMPN [	MOVEI 1			;BLOCK #1
14100			MOVEM BLKNUM
14200			JRST PLA2]
14300	NOTHIN:	JUMPE [	OUTSTR [ASCIZ/NOTHING THERE!!!/]
14400			CALLI 12]
14500		SKIPE A,NWD+20
14600		SKIPN B,NWD+21
14700		JRST NOTHIN
14800		MOVEM A,BLKNUM
14900		MOVEM B,NWD
15000	PLA2:	MOVEI A,10
15100	;	MOVEM A,WT#
15200	 	SETOM A,WT#
15300		SETZM OUTWC
15400	;;	OUTSTR[ASCIZ/WAITING TO BE LOCKED IN CORE.../]
15500		LOCK
15600	;;	OUTSTR[ASCIZ/OK
15700	;;/]
15800	;;	SPCWAR 17,SWJOB
15900		MOVEI A,1
16000		SKIPL WT
16100		JRST[	CALLI A,31
16200			JRST .-1]
16300		MESSAGE [ASCIZ/
16400	GO? /]
16500		READCH A
16600		CAIE A,175
16700		CAIN A,177
16800		JRST BEG
16900		MOVE A,[SIXBIT/GOT 6!/]
17000		CALLI A,400002
     

00100	; BEGIN MAIN BODY OF PROGRAM
00200	
00300		SETZM DATERR
00400		SETZM RUDONE
00500		SETZM PDPERR
00600	LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
00700	PBUF1:	0	;BUF1-1		;USE BUF1 FOR THE I/O
00800		JUMPLE	B,OUT1   	;DONE
00900		
01000		JSP	RET,SUB		;CALL IT AGAIN
01100	PBUF2:	0	;BUF2-1		;USE BUF2 FOR THE I/O
01200		JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
01300	OUT1:	SKIPN RUDONE
01400		JRST OUT1
01500	OUT:	UNLOCK			;UNLOCK US FROM CORE!
01600	;;	SPCWAR 0,'SSW'
01650		
01700		MOVE A,[SIXBIT/UDPLAY/]
01800		CALLI A,400002
01900		close dskchn,		;END OF PROGRAM.
02000		releas adchn,
02050		RELEASE 16,
02100		CALLI 0			;RESET I/O AND FREE BUFFER SPACE
02200	SHRINK:	MOVE A,JOBFF
02300		CALL A,[SIXBIT/CORE/]
02400		JRST [	OUTSTR[ASCIZ/
02500	HORRIBLE ERROR! CAN'T SHRINK CORE!!!
02600	/]
02700		HALT SHRINK]
02800		SKIPE DATERR
02900		JRST[	MESSAGE[ASCIZ/
03000	Data transmission error.
03100	/]
03200			JRST LX]
03300		SKIPE PDPERR
03400		JRST[	MESSAGE[ASCIZ/
03500	The PDP-6 is hung, try restarting it.
03600	/]
03700			CALLI  12]
03800		SKIPLE NWD
03900		JRST [ MESSAGE[ASCIZ/
04000	%*#%*!% SYSTEM, CAN'T GET UDP ACCESS FAST ENOUGH OR NOT BEING RUN QUICKLY ENOUGH,
04100	TRY AGAIN, AND IF YOU STILL LOSE, SEE IF YOU CAN GET PEOPLE TO STOP WHILE
04200	YOU TRY A THIRD(?) TIME.
04300	GOOD LUCK!
04400	/]
04500			JRST LX]
04600		jrst LX
     

00100	; SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
00200	;  1(RET) WILL BE THE RETURN
00300	;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
00400	;         PUT IN THE RIGHT HALF OF THE IOWD.
00500	;  A      WILL BE A WORK REGISTER
00600	;  B      WILL BE TESTED ON THE OUTSIDE.
00700	
00800	SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
00900		ADDB	A,NWD		;A←NWD-BUFSIZ
01000					;NWD←NWD-BUFSIZ
01100		MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
01200					;TIME.
01300		JUMPLE	A,LAST		;SET UP FOR LAST TIME.
01400		MOVEI	A,0		
01500	
01600		;THE IOWD LOOKS LIKE:
01700		;  [-BUFSIZ / BUFI-1]
01800	
01900	LAST:	ADDI	A,BUFSIZ
02000		MOVNS	A		;COMPLEMENT A
02100		HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
02200					;TO THE LEFT SIDE OF A.
02300		MOVSM	A,INLIST	;SWAP A AND MOVE IT.
02400		MOVEI C,5*=60		;IF IT DOESN'T RESPOND IN 5 SECONDS, ASSUME PDP-6
02500					;IS HUNG
02600	FULOOP:	SKIPGE OUTWC
02700		JRST [	SETZ 0
02800			CALLI 31	;SLEEP FOR A TICK
02900			SOJGE C,FULOOP
03000			SETOM PDPERR
03100			JRST OUT]
03200		SKIPE RUDONE
03300		JRST OUT
03400		INPUT	DSKCHN,INLIST	;READ A RECORD.
03500		MOVSM	A,OUTWC		;SAME FOR OUTPUT.
03600		MOVEI A,BLKS
03700		ADDM A,BLKNUM
03800		JRST	1(RET)		;RETURN
     

00100	; SPACE WAR JOB
00200	
00300		BEGIN SWJOB
00400	
00500	↑SWJOB:	SOSL WT
00600		CALLI 400024
00700		SKIPL OUTWC
00800		CALLI 400024
00900		MOVE 1,OUTWC
01000		SETZM OUTWC
01100		SKIPE RUDONE
01200		CALLI 400024
01300		CONSZ 40		;CHECK TO SEE IF ON THE PDP-6
01400		JRST[	SETOM PDPERR
01500			SETOM RUDONE
01600			CALLI 400024]
01700		CONO 4,400
01800		MOVE 2,OUTBIT
01900		CONO 424,(2)
02000		MOVE 2,OUTWC+1
02100		CONO 204,(2)
02200	L1:	CONSO 204,1000
02300		JRST L1
02400		BLKO 204,1
02500		JRST[	MOVE 1,OUTWC
02600			SETZM OUTWC
02700			JUMPL 1,L1
02800			CONSZ 204,10000
02900		EHO:	SETOM DATERR
03000			SETOM RUDONE
03100			CONO 4,200
03200			CALLI 400024]
03300		JRST L1
03400	↑PDPERR: 0
03500	↑DATERR: 0
03600	↑RUDONE: 0
03700		BEND SWJOB
     

00100	; GETBUF - MAKE AN I/O BUFFER
00200	
00300		BEGIN ALLOC
00400	
00500	↑GETBUF:ADD A,JOBFF	
00600		PUSH P,A	;SAVE WHAT WILL BE JOBFF
00700	GETBU2:	CALL A,[SIXBIT/CORE/]
00800		JRST [	OUTSTR [ASCIZ/
00900	Can't get enough core!
01000	/]
01100			MOVE A,(P)	;RECOVER WHAT SHOULD BW JOBFF
01200			HALT GETBU2]	;ALLOW THE LOSER TO TRY AGAIN
01300		POP P,A		;RECOVER WHAT WILL BE JOBFF
01400		EXCH A,JOBFF
01500		POPJ P,
01600	
01700		BEND ALLOC
     

00100	; STORAGE:
00200	
00300	NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
00400		BLOCK 21		;TO GET SCRATCH ADDRESS
00500	CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
00600		0
00700	
00800	INLIST:	0			;WILL CONTAIN AN IOWD
00900	BLKNUM:	0
01000	
01100	OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
01200		3650			;MAGIC BITS FOR 136.
01300	OUTBIT: 4000			;BITS FOR D-A
01400		BLOCK  2
01500	PLIST:	BLOCK PLEN
01600	
01700	PATCH:	BLOCK 20
01800	
01900	end beg